home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / prov-req.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-06  |  4.9 KB  |  127 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         prov-req.lsp
  5. ; RCS:          $Header: prov-req.lsp,v 1.2 91/10/05 18:46:00 mayer Exp $
  6. ; Description:  Pseudo version of common lisp's provide/require functionality
  7. ;        Note that this uses the X11r4 routine XT_RESOLVE_PATHNAME
  8. ;        XtResolvePathname(), therefore you can only use this w/
  9. ;        Motif 1.1.
  10. ; Author:       Eric Blossom, HP Response Center Lab; Niels Mayer, HP Labs.
  11. ; Created:      Mon Feb 12 19:05:25 1990
  12. ; Modified:     Sat Oct  5 18:45:39 1991 (Niels Mayer) mayer@hplnpm
  13. ; Language:     Lisp
  14. ; Package:      N/A
  15. ; Status:       X11r5 contrib tape release
  16. ;
  17. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  18. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  19. ;
  20. ; Permission to use, copy, modify, distribute, and sell this software and its
  21. ; documentation for any purpose is hereby granted without fee, provided that
  22. ; the above copyright notice appear in all copies and that both that
  23. ; copyright notice and this permission notice appear in supporting
  24. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  25. ; used in advertising or publicity pertaining to distribution of the software
  26. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  27. ; makes no representations about the suitability of this software for any
  28. ; purpose.  It is provided "as is" without express or implied warranty.
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30.  
  31. ;;;
  32. ;;; I use prov-req.lsp to set up a load-path for WINTERP.
  33. ;;;
  34. ;;; Put 
  35. ;;; (PROVIDE <module-name>) 
  36. ;;; at the end of each file/module/class/<program-unit>
  37. ;;; PROVIDE indicates that a file <module-name> has been
  38. ;;; loaded. Once a file is LOADed and PROVIDE'd,
  39. ;;; (REQUIRE <module-name>) will not re-LOAD
  40. ;;; <module-name> again. <module-name> can be a string
  41. ;;; or a symbol.
  42. ;;;
  43. ;;; (REQUIRE <module-name> [<path>])
  44. ;;; will load <module-name> if it hasn't been PROVIDE'd
  45. ;;; already. <module-name> is a string or a symbol. If
  46. ;;; <path> isn't provided, *default-load-path*=="%N%S:%N"
  47. ;;; is used in it's place. See documentation for
  48. ;;; XtResolvePathname() for an explanation of load-paths.
  49. ;;; If <module-name>=="file", then 
  50. ;;; by default, the default load path will load
  51. ;;; "file.lsp" out of the directory specified by resource
  52. ;;; "Winterp.lispLibDir" or by the command line arg -lisp_lib_dir.
  53. ;;; ... 
  54. ;;;
  55. ;;; I do the following in my winterp startup file ~/.winterp,
  56. ;;; which I specify thru Xdefault "Winterp.lispInitFile: /users/mayer/.winterp"
  57. ;;;
  58. ;;; (setq *default-load-path*
  59. ;;;       (strcat
  60. ;;;        "/users/mayer/%N%S:"
  61. ;;;        "/users/mayer/%N:"
  62. ;;;        "/users/mayer/src/widgit/examples/%N%S:"
  63. ;;;        "/users/mayer/src/widgit/examples/%N:"
  64. ;;;        "/tmp/%N%S:"
  65. ;;;        "/tmp/%N"
  66. ;;;        ))
  67. ;;;
  68. ;;; (load "/users/mayer/src/widgit/examples/prov-req.lsp")
  69.  
  70. (defvar *default-load-path* "%N%S:%N")    ;load-path, see XtResolvePathname()
  71. (defvar *modules-size* 20)        ;size of hashtable.
  72. (setq *modules* (make-array *modules-size*))
  73.  
  74. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  75. ;
  76. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  77. (defun provide (module-name)
  78.   (let ((file-str (cond ((symbolp module-name)
  79.              (symbol-name module-name))
  80.             ((stringp module-name)
  81.              module-name)
  82.             (t
  83.              (error "Wrong type argument to PROVIDE" module-name)))
  84.           ))
  85.     
  86.     (let ((hashbucket (aref *modules* (hash file-str *modules-size*))))
  87.       (if (member file-str (aref *modules* (hash file-str *modules-size*))
  88.           :test #'equal)
  89.       t
  90.     (setf (aref *modules* (hash file-str *modules-size*))
  91.           (cons file-str hashbucket))
  92.     ))
  93.     ))
  94.  
  95. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  96. ;
  97. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  98. (defun require (module-name &optional pathname)
  99.   (let ((file-str (cond ((symbolp module-name)
  100.              (symbol-name module-name))
  101.             ((stringp module-name)
  102.              module-name)
  103.             (t
  104.              (error "Wrong type argument to REQUIRE" module-name)))))
  105.  
  106.     (if (member file-str (aref *modules* (hash file-str *modules-size*))
  107.         :test #'equal)
  108.     t        
  109.       (let (
  110.         (filepath-str (XT_RESOLVE_PATHNAME nil ;ignore all %T substitutions
  111.                            file-str    ;substitute for %N
  112.                            ".lsp" ;substitute for %S
  113.                            (if pathname pathname *default-load-path*))))
  114.     (if (null filepath-str)
  115.         (error (format nil "Can't find module ~A in path ~A" file-str (if pathname pathname *default-load-path*))))
  116.  
  117.     (if (not (load filepath-str :verbose T :print NIL))
  118.         (error "Can't load required module" filepath-str)
  119.       t
  120.       ))
  121.       )))
  122.  
  123. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  124. ;
  125. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  126. (provide "prov-req")
  127.